perm filename VLISP.YSS[VLI,LSP] blob
sn#382113 filedate 1978-09-15 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00010 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 S Y S : V L I S P . I N I
C00004 00003 ERROR.UBV ERROR.UDFE ERROR.UDFA ESCAPE.I
C00007 00004 Quelques fonctions sur fichiers disques
C00009 00005 SYNONYM MACROS et macros-caracteres
C00011 00006 fonctions autoloadables
C00012 00007 WHOIS et WHOISALL
C00014 00008 On a toujours besoin de petites fonctions
C00015 00009 READFTMPCOR : lecture du TMPCOR de ETV
C00016 00010 final : IDENTIFICATION et lecture DSK:VLISP.INI
C00019 ENDMK
C⊗;
; S Y S : V L I S P . I N I ;
; ;
; Fichier initial standard de VLISP 10 . 3 ;
;----------------------------------------------------------;
; Jerome CHAILLOUX ;
; ;
; Universite de Paris VIII - Vincennes ;
; Route de la Tourelle 75012 Paris ;
; Tel : 374 12 50 poste 299 ;
; ;
; I.R.C.A.M. ;
; 31 Rue St Merri 75004 Paris ;
; Tel : 277 12 33 poste 48-48 ;
;----------------------------------------------------------;
(STATUS 2 0 1 2) ; silence !!! ;
;;; ERROR.UBV ERROR.UDFE ERROR.UDFA ESCAPE.I ;;;
;;; Definition des traps erreurs ;;;
(DE ERROR.UBV (atome pile p$bind)
(PRINT "Variable indefinie : " atome)
(OR (EQ p$bind -1)
(PROGN
(PRINTLEVEL 6)
(PRINTLENGTH 10)
(PRINT "La derniere FONCTION etait : "
(VAG (STATUS 41 (ADD1 (LOGAND p$bind \777777))) ))
(PRINTLEVEL 50)
(PRINTLENGTH 2000)))
(RESET))
(DE ERROR.UDFE (fonction forme pile p$bind)
; UNdefined function EVAL ;
(ERROR.UDF "Fonction indefinie dans EVAL : "))
(DE ERROR.UDFA (fonction forme pile p$bind)
; Undefined function APPLY ;
(ERROR.UDF "Fonction indefinie dans APPLY : "))
(DE ERROR.UDF (msg)
; Fonction generale d'erreur FUNCTION UNDEFINED ;
(PRINT msg fonction)
(PRINTLEVEL 6)
(PRINTLENGTH 10)
(PRINT "La derniere forme etait : " forme)
(OR (EQ p$bind -1)
(PRINT "La derniere FONCTION etait : "
(VAG (STATUS 41 (ADD1 (LOGAND p$bind \777777))) )))
(PRINTLEVEL 50)
(PRINTLENGTH 2000)
(RESET))
(DE ESCAPE.I (numero pile p$bind lu it)
(TERPRI)
(PRINT "Je rentre dans un TOPLEVEL ESCAPE-I.")
(PRINT "Pour en sortir, commence une ligne par <META-ESPACE>.")
(STATUS 11 '/!)
(TEREAD)
(UNTIL (EQ (PEEKCH) '/ )
(SETQ lu (READ))
(SETQ it (PRINT (EVAL lu))))
(STATUS 11 '/?)
(PRINT "Ca roule..."))
;;; Quelques fonctions sur fichiers disques ;;;
(DF LAPIN (filin)
; lit un fichier d'extension LAP ;
(SETQ filin (CAR filin))
(DE EOF () (REMPROP 'EOF EXPR) (INPUT) (&EOF))
(INPUT ['DSK (CONS filin 'LAP)])
(ESCAPE &EOF (WHILE T (EVAL (READ))))
filin)
(DF BACKUP (filin)
; cre un fichier disque de BACKUP ;
(SETQ filin (OR (CAR filin) (GENSYM)))
(STATUS 2 20) ; format packe ;
(OUTPUT filin)
filin)
(DF BACKEND ()
; fin du backup ;
(STATUS 1 20)
(OUTPUT)
'BACKEND)
(DF DUMPF (ls ;; filout)
; (DUMPF file fonct1 ... fonctN) ;
(SETQ filout ['DSK (CONS (NEXTL ls) 'VLI)])
(OUTPUT filout)
(WHILE ls (EVAL ['PRETTY (NEXTL ls)]))
(OUTPUT)
filout)
(DE HELP ()
; simule la commande moniteur : .HELP VLISP ;
; Ca mange pas de pain ;
(TYPE '(HLP (VLISP . HLP))))
(DE TYPE (filin)
; simule la commande moniteur .TYPE file ;
(INPUT filin)
(STATUS 17 (ASCII \15) 2)
(DE EOF ()
(REMPROP 'EOF EXPR)
(STATUS 1 20)
(TERPRI)
(INPUT)
(&EOF))
(ESCAPE &EOF (WHILE T (PRINC (READCH))))
(STATUS 17 (ASCII \15) 0)
filin)
;;; SYNONYM MACROS et macros-caracteres ;;;
(SYNONYM 'GTZ 'GZP) ; pour rendre Harald HEUREUX ;
(SYNONYM '=0 'ZEROP)
(SYNONYM '#0 'NEROP)
(SYNONYM '>0 'GZP)
(SYNONYM '<0 'LZP)
(SYNONYM '>=0 'GEZP)
(SYNONYM '<=0 'LEZP)
; On peut vraiment pas vivre sans ? ;
(DM LET (ls) (RPLACB ls
(CONS (MCONS LAMBDA (MAPCAR (CADR ls) 'CAR) (CDDR ls))
(MAPCAR (CADR ls) 'CADR))))))
;;; AVEC LES DATA-MEDIAS QUELQUES MACROS-CARACTERES UTILES ;;;
(DMC /λ () ;↑H; 'LAMBDA)
(DMC /⊃ () ;↑Q; (STATUS 1 5) (STATUS 21) (STATUS 2 5) NIL)
(DMC /↓ () ;↑A; ['LIBRARY (READ)])
(DMC /← () ; ; (STOP))
(DMC /⊂ () ;↑P; ['PRETTY (READ)])
(DMC /ε () ;↑F; ['PHENARETE (READ)])
(DMC /π () ;↑G; (DISPLAY '(\177 7)) '/π)
;;; Utilise le nouveau trait RUN ;;;
(DMC /↔ () ;↑W; (RUN '(SYS (WHO . SAV))))
(DMC /¬ () ;↑E; (RUN '(SYS (E . SHR)) -1))
;;; Puisqu'on est sur DATA-MEDIAS ;;;
(DE TTYDMP ()
; teste si le terminal utilise est en TTY DM mode ;
; ramene NIL si faux (sinon ramene un nb qcq) ;
(LZP (TRMOP \1043 () ())))
; fonctions autoloadables ;
(PATHLIBRARY ()
; directories utiles ;
SYS
(vli . JER)
(vli . pg)
(vli . HAR)
(LIS . GOO)
(LIS . LOU))
(AUTOLOAD AID COUNT UNCOUNT PACKFILE SIZE SIZEFILE)
(AUTOLOAD COMPIL COMPILEF COMPILEND COMPILOPTIONS)
;
(if (eq 5 (REM (QUO (STATUS 36) 1000) 10))
(repeat 50
(print "Non, rien de rien, non, je ne regrette rien")))
;
; WHOIS et WHOISALL ;
(DF whois (name ;; ligne jelai)
; (WHOIS nom) ramene le nom du mec ;
; ca fait ca intelligement : ;
; (WHOIS JEROME) -> "JER Jerome Chailloux" ;
; (WHOIS JER) -> "JER Jerome Chailloux" ;
; (WHOIS CHAILLOUX) -> "JER Jerome Chailloux" ;
(SETQ name (CAR name))
(DE EOF () (REMPROP 'EOF 'EXPR) (&eof))
(INPUT '(SYS (FACT . TXT)))
(ESCAPE &eof
(WHILE T (SETQ ligne (READSTR))
(MAPC (IMPLODE (CONCAT "(" ligne ")"))
(LAMBDA (nom)
(IF (SAMEPN nom name)
(PROGN (PRINT ligne) (SETQ jelai T)))))))
(INPUT)
(OR jelai "Nie ma ..."))))
(DE whoisall ()
; liste tout sys:fact.txt ;
; appel : (WHOISALL) c'est tout ;
(DE EOF () (REMPROP 'EOF 'EXPR)
(INPUT)
(&eof))
(INPUT '(SYS (FACT . TXT) (SPL . SYS)))
(ESCAPE &eof
(WHILE T (MAPC (IMPLODE (CONCAT "(" (READSTR) ")" ))
'PRIN1)
(TERPRI)))))))))
;;; On a toujours besoin de petites fonctions ;;;
(DE FOO (n) (IF (ZEROP n) 1 (* n (SELF (1- n))))))))
(DE FOON (N M) (ADD1 (PLUS N M 6)))
; pour faire sonner la cloche .. ;
(DE BEEP () (DISPLAY '(\177 7)))
(DE OUTSTR (str)
; equivalent de l'UUO OUTSTR : ;
; i.e. ecrit sur le terminal la chaine <str> ;
(MAPC (MAPCAR (MAKLIST str) 'CASCII) 'TYO)
(STATUS 22)
(STATUS 22)
str))
; READFTMPCOR : lecture du TMPCOR de ETV ;
(DE READFTMPCOR ( ;; l filin)
(SETQ l (TMPCOR 'ED))
(IFN (LISTP l) (LESCAPE))
(OR (AND (EQ (NEXTL l) 'E)
(EQ (NEXTL l) 'T)
(NEXTL l))
(LESCAPE))
(SETQ filin)
(WHILE (NEQ (CAR l) '/.) (SETQ filin (CONS (NEXTL l) filin)))
(NEXTL l)
(OR (AND (EQ (NEXTL l) 'V)
(EQ (NEXTL l) 'L)
(EQ (NEXTL l) 'I))
(LESCAPE))
(SETQ filin (APPLY 'GENSYM (REVERSE filin)))))))
; final : IDENTIFICATION et lecture DSK:VLISP.INI ;
(PROGN
; init de la taille des ecrans DATA-MEDIAS ;
(AND (IRCAMP) (STATUS 9 76))
; edition du numero de version, date, heure et PPN ;
(SETQ VERSION (VERSION))
(PRIN1
(SETQ VERSION (GENSYM
'VLISP
'/
(LOGAND \777 (LOGSHIFT (SWAP VERSION) -6))
'/.
(LOGAND \77 (SWAP VERSION))
(MINUS (LOGAND \777777 VERSION))))
(DATE)
(TIME)
(GETPPN))
(STATUS 1 20) (TERPRI)
(POUR EVAL (OUTSTR "SYS:VLISP.INI loaded.
"))
(IFN (DIRECTORY () '(VLISP . INI))
(PROGN (SETQ filin (READFTMPCOR))
(IF filin (PROGN (INPUT filin)
(READCH) ; meme obscure raison IRCAM ;
(WHILE (NEQ (READCH '/;)))
(STATUS 2 0 1 2)
(DE EOF ()
(REMPROP 'EOF EXPR)
(OUTSTR (CONCAT "DSK: " filin
".VLI loaded.
"))
(status 1 20)
(status 1 0 1 2)
"VLISP est encore gagnant"))
(INPUT) (STATUS 1 0 1 2) ; passage en mode TTY ;
"VLISP est encore gagnant"))
; sinon le fichier DSK:VLISP.INI existe ;
(INPUT '(DSK (VLISP . INI)))
(STATUS 2 0 1 2) ; la lecture est silencieuse ;
(DE EOF ()
(TERPRI)
(SETQ filin (READFTMPCOR))
(IFN filin
(PROGN (REMPROP 'EOF EXPR)
(STATUS 2 20)
(STATUS 1 0 1 2)
(RESET))
(INPUT filin)
(READCH) ; mais je vois vraiment pas pourquoi ?????? ;
(STATUS 2 0 1 2)
(DE EOF ()
(REMPROP 'EOF EXPR)
(OUTSTR (CONCAT "DSK:" filin ".VLI loaded.
"))
(STATUS 1 20)
(STATUS 1 0 1 2)
(RESET)))))))))))))))))))))))))